home *** CD-ROM | disk | FTP | other *** search
/ Software 2000 / Software 2000 Volume 1 (Disc 1 of 2).iso / utilities / u287.dms / in.adf / Source / Calls.p next >
Encoding:
Text File  |  1991-03-26  |  5.2 KB  |  226 lines
  1. External;
  2.  
  3. {
  4.     Calls.p (of PCQ Pascal)
  5.     Copyright (c) 1989 Patrick Quaid
  6.  
  7.     Calls.p is the first attempt to organize the various
  8. addressing and code generating routines in one section.  If you
  9. read the other sections you'll find that not much effort went into
  10. this project.  Nonetheless, a couple of common addressing things
  11. can be found here.
  12.     If the compiler were designed so that all the addressing
  13. things were here, it would be much easier to port to a different
  14. processor.
  15. }
  16.  
  17. {$O-}
  18. {$I "Pascal.i"}
  19.  
  20.     Function Match(s : Symbols) : Boolean;
  21.         external;
  22.     Procedure Error(s : string);
  23.         external;
  24.     Function FindField(s : string; TP : TypePtr): IDPtr;
  25.         external;
  26.     Function FindWithField(S : String) : IDPtr;
  27.         External;
  28.     Procedure NextSymbol;
  29.         external;
  30.     Function Expression : TypePtr;
  31.         external;
  32.     Function GetReference : ExprPtr;
  33.         External;
  34.     Procedure EvalAddress(Expr : ExprPtr; ToReg : Regs);
  35.         External;
  36.     Procedure FreeAllRegisters;
  37.         External;
  38.     Procedure Optimize(Expr : ExprPtr);
  39.         External;
  40.     Function TypeCheck(t1, t2 : TypePtr): Boolean;
  41.         external;
  42.     Function TypeCmp(t1, t2 : TypePtr) : Boolean;
  43.         external;
  44.     Function FindID(s : string) : IDPtr;
  45.         external;
  46.     Function IsVariable(i : IDPtr) : Boolean;
  47.         external;
  48.     Function GetLabel() : Integer;
  49.         external;
  50.     Procedure ns;
  51.         external;
  52.     Procedure Mismatch;
  53.         external;
  54.     Function SimpleType(t : TypePtr): Boolean;
  55.         external;
  56.     Function NumberType(t : TypePtr): Boolean;
  57.         external;
  58.     Procedure AddConstant(Amount : Integer; Reg : Regs; Size : Byte);
  59.         External;
  60.     Function ReadParameters(ID : IDPtr) : ExprPtr;
  61.         External;
  62.     Function PushArguments(Args : ExprPtr; ToReg : Regs) : Integer;
  63.         External;
  64.     Function PushFrame(Level : Integer) : Integer;
  65.         External;
  66.     Procedure Out_Operation0(op : OpCodes);
  67.         External;
  68.     Procedure Out_Operation1(op : OpCodes; Size : Byte;
  69.                     EA : EAModes; Reg : Regs);
  70.         External;
  71.     Procedure Out_Operation2(op : OpCodes; Size : Byte;
  72.                     SrcEA : EAModes; SrcReg : Regs;
  73.                     DestEA : EAModes; DestReg : Regs);
  74.         External;
  75.     Procedure Out_Extension(Ext : Integer);
  76.         External;
  77.  
  78. Procedure PushLongD0;
  79. begin
  80.     Out_Operation1(op_PUSH,4,ea_Register,d0);
  81.     StackLoad := StackLoad + 4;
  82. end;
  83.  
  84. Procedure PopLongD0;
  85. begin
  86.     Out_Operation1(op_POP,4,ea_Register,d0);
  87.     StackLoad := StackLoad - 4;
  88. end;
  89.  
  90.  
  91. Procedure PopStackSpace(amount : Integer);
  92. begin
  93.     AddConstant(Amount, a7, 4);
  94.     StackLoad := StackLoad - amount;
  95. end;
  96.  
  97. Procedure PushWordD0;
  98. begin
  99.     Out_Operation1(op_PUSH,2,ea_Register,d0);
  100.     StackLoad := StackLoad + 2;
  101. end;
  102.  
  103. Procedure PushLongD1;
  104. begin
  105.     Out_Operation1(op_PUSH,4,ea_Register,d1);
  106.     StackLoad := StackLoad + 4;
  107. end;
  108.  
  109. Procedure PopLongD1;
  110. begin
  111.     Out_Operation1(op_POP,4,ea_Register,d1);
  112.     StackLoad := StackLoad - 4;
  113. end;
  114.  
  115. Procedure PushLongA0;
  116. begin
  117.     Out_Operation1(op_PUSH,4,ea_Register,a0);
  118.     StackLoad := StackLoad + 4;
  119. end;
  120.  
  121. Procedure PopLongA0;
  122. begin
  123.     Out_Operation1(op_POP,4,ea_Register,a0);
  124.     StackLoad := StackLoad - 4;
  125. end;
  126.  
  127. Procedure PopLongA1;
  128. begin
  129.     Out_Operation1(op_POP,4,ea_Register,a1);
  130.     StackSpace := StackSpace - 4;
  131. end;
  132.  
  133. Procedure DoRangeCheck(VarType : TypePtr);
  134.  
  135. {
  136.     This routine is called from selector() when range checking
  137. is turned on.  Notice that the code is now in a library, rather
  138. than inline as it was in 1.0.  Also note that the library code fixes
  139. the stack after the call.
  140. }
  141.  
  142. begin
  143.     Out_Operation1(op_PEA,3,ea_Absolute,a7);
  144.     Out_Extension(VarType^.Lower);
  145.     Out_Operation1(op_PEA,3,ea_Absolute,a7);
  146.     Out_Extension(VarType^.Upper);
  147.     Out_Operation1(op_JSR,3,ea_String,a7);
  148.     Out_Extension(Integer("_p%CheckRange"));
  149. end;
  150.  
  151. Function GetFramePointer(Reference : Integer) : Regs;
  152. var
  153.     Current : Integer;
  154. begin
  155.     Current := CurrentBlock^.Level;
  156.     if Current = Reference then
  157.     GetFramePointer := a5
  158.     else begin
  159.     Out_Operation2(op_MOVE,4,ea_Index,a5,ea_Register,a4);
  160.     Out_Extension(8);
  161.     Dec(Current);
  162.     while Current > Reference do begin
  163.         Out_Operation2(op_MOVE,4,ea_Index,a4,ea_Register,a4);
  164.         Out_Extension(8);
  165.         Dec(Current);
  166.     end;
  167.     GetFramePointer := a4;
  168.     end;
  169. end;
  170.  
  171. Function LoadAddress : TypePtr;
  172.  
  173. {
  174.     This is the routine used wherever I need the address of a
  175. variable, for example reference parameters or the adr() function.
  176. The address is loaded into a0.
  177. }
  178.  
  179. var
  180.     Expr    : ExprPtr;
  181. begin
  182.     NextFreeExprNode := 0;
  183.     FreeAllRegisters;
  184.     Expr := GetReference;
  185.     Optimize(Expr);
  186.     EvalAddress(Expr,a0);
  187.     LoadAddress := Expr^.EType;
  188. end;
  189.  
  190. Procedure CallProc(ProcID : IDPtr);
  191.  
  192. {
  193.     This routine handles the nitty-gritty of calling a
  194.     procedure.  A very similar routine exists in Evaluate
  195.     called Eval_FunctionCall, which does most of the same
  196.     stuff but accepts a return value.
  197. }
  198. var
  199.     ArgSize : Integer;
  200.     Args    : ExprPtr;
  201.     OneArg    : ExprPtr;
  202. begin
  203.     NextSymbol;  { Read past procedure identifier }
  204.     NextFreeExprNode := 0;
  205.  
  206.     Args := ReadParameters(ProcID);
  207.     OneArg := Args;
  208.     while OneArg <> Nil do begin
  209.     Optimize(OneArg);
  210.     OneArg := OneArg^.Next;
  211.     end;
  212.  
  213.     FreeAllRegisters;
  214.  
  215.     ArgSize := PushArguments(Args, d0);
  216.  
  217.     ArgSize := ArgSize + PushFrame(ProcID^.Level);
  218.  
  219.     Out_Operation1(op_JSR,3,ea_Global,a7);
  220.     Out_Extension(Integer(ProcID));
  221.  
  222.     PopStackSpace(ArgSize);
  223.  
  224.     MathLoaded := False;
  225. end;
  226.